Magnum One/Magnum One (Mid-American Digital) (Disc Manufacturing).iso/d18/vis082s.arc/OTHERS.PAS

Pascal/Delphi Source File | 1991-04-18 | 38.1 KB | 1,454 lines

{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }

unit others;

interface

uses crt,dos,
gentypes,configrt,modem,statret,gensubs,subs1,windows,subs2,textret,
     mailret,userret,flags,mainr1,ansiedit,lineedit,
     mainr2,overret1;


procedure showuserstats(u:userrec);
procedure edituser (eunum:integer);
procedure printnews;
function selectspecs (var us:userspecsrec):boolean; { True if user aborts }
procedure editoldspecs;
procedure readfeedback;
procedure showallsysops;
procedure editusers;
procedure zapspecifiedusers;
Procedure RemoteDosShell;

implementation



procedure delallmail (n:integer);
var cnt,delled:integer;
    m:mailrec;
    u:userrec;
begin
  cnt:=-1;
  delled:=0;
  repeat
    cnt:=searchmail(cnt,n);
    if cnt>0 then begin
      delmail(cnt);
      cnt:=cnt-1;
      delled:=delled+1
    end
  until cnt=0;
  if delled>0 then writeln (^B'Mail deleted: ',delled);
  writeurec;
  seek (ufile,n);
  read (ufile,u);
  deletetext (u.infoform);
  deletetext (u.infoform2);
  deletetext (u.infoform3);
  deletetext (u.infoform4);
  deletetext (u.infoform5);
  deletetext (u.emailannounce);
  u.infoform:=-1;
  u.infoform2:=-1;
  u.infoform3:=-1;
  u.infoform4:=-1;
  u.infoform5:=-1;
  u.emailannounce:=-1;
  writeufile (u,n);
  readurec
end;

procedure deleteuser (n:integer);
var u:userrec;
begin
  delallmail (n);
  fillchar (u,sizeof(u),0);
  u.infoform:=-1;
  u.infoform2:=-1;
  u.infoform3:=-1;
  u.infoform4:=-1;
  u.infoform5:=-1;
  u.emailannounce:=-1;
  writeufile (u,n)
end;


function postcallratio (var u:userrec):real;
begin
  if u.numon=0
    then postcallratio:=0
    else postcallratio:=u.nbu/u.numon
end;

function fitsspecs (var u:userrec; var us:userspecsrec):boolean;
var days:integer;
    pcr:real;
    thisyear,thismonth,thisday,t:word;
    lastcall:datetime;

  function inrange (n,min,max:integer):boolean;
  begin
    inrange:=(n>=min) and (n<=max)
  end;

begin
  unpacktime (u.laston,lastcall);
  getdate (thisyear,thismonth,thisday,t);
  days:=(thisyear-lastcall.year)*365+(thismonth-lastcall.month)*30+
        (thisday-lastcall.day);
  pcr:=postcallratio (u);
  fitsspecs:=inrange (u.level,us.minlevel,us.maxlevel) and
             inrange (days,us.minlaston,us.maxlaston) and
             (pcr>=us.minpcr) and (pcr<=us.maxpcr);
  if (datepart(u.expdate)<datepart(Now)) and us.expired and (datepart(u.expdate)<>0)
  then fitsspecs:=true;
end;


procedure showuserstats(u:userrec);
var knter:integer;
    tpstr:lstr;
begin
  clearscr;
  blowup(1,1,47,11);
  printxy(1,3,^R'[ '^S'ViSiON User Status'^R' ]');
  printxy(2,3,^R'User Handle.: '^S+u.handle);
  printxy(3,3,^R'Real Name...: '^S+u.realname);
  printxy(4,3,^R'User Note...: '^S+u.usernote);
  printxy(5,3,^R'Main Level..: '^S+strr(u.level));
  printxy(6,3,^R'Phone Number: '^S+u.phonenum);
  if issysop then printxy(7,3,^R'Password....: '^S+u.password) else
  printxy(7,3,^R'Password....: '^S+'[CLASSIFIED]');
  printxy(8,3,^R'Last time On: '^S+datestr(u.laston));
  printxy(9,3,^R'Total Calls.: '^S+strr(u.numon));
  printxy(10,3,^R'Total Posts.: '^S+strr(u.nbu));

  blowup(1,50,28,8);
  printxy(1,52,^R'[ '^S'Xfer Status'^R' ]');
  printxy(2,52,^R'Level....: '^S+strr(u.udlevel));
  printxy(3,52,^R'Points...: '^S+strr(u.udpoints));
  printxy(4,52,^R'Uploads..: '^S+strr(u.uploads));
  printxy(5,52,^R'Downloads: '^S+strr(u.downloads));
  printxy(6,52,^R'U/L K....: '^S+strr(u.upkay));
  printxy(7,52,^R'D/L K....: '^S+strr(u.dnkay));

  blowup(13,1,56,5);
  tpstr:='';
  for knter:=1 to 10 do begin
    if knter<>1 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
    tpstr:=tpstr+'0'
  end;
  printxy(14,3,^R'Sub-Conferences.: '^S);
  printxy(14,21,tpstr);
  tpstr:='';
  for knter:=11 to 20 do begin
    if knter<>11 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
     tpstr:=tpstr+'0';
  end;
  printxy(15,21,tpstr);
  tpstr:='';
  for knter:=21 to 30 do begin
    if knter<>21 then tpstr:=tpstr+',';
    if (u.confset[knter]>0) then tpstr:=tpstr+strr(knter) else
      tpstr:=tpstr+'0';
  end;
  printxy(16,21,tpstr);
  printxy(20,1,'');
end;

procedure edituser (eunum:integer);
var eurec:userrec;
    ca:integer;
    k:char;
const sysopstr:array [false..true] of string[6]=('Normal','Sysop');
      sectionnames:array [udsysop..databasesysop] of string[20]=
        ('File transfer','Bulletin section','Voting booths',
         'E-mail section','Doors','Main menu','Databases');

  procedure truesysops;
  begin
    writeln ('Sorry, you may not do that without true sysop access!');
    writelog (18,17,'')
  end;

  function truesysop:boolean;
  begin
    truesysop:=ulvl>=configset.sysopleve
  end;

  procedure getmstr (t:mstr; var mm);
  var m:mstr absolute mm;
  begin
    writeln ('Old ',t,': '^S,m);
    writestr ('New '+t+'? *');
    if length(input)>0 then m:=input
  end;

  procedure getsstr (t:mstr; var s:sstr);
  var m:mstr;
  begin
    m:=s;
    getmstr (t,m);
    s:=m
  end;

  procedure getint (t:mstr; var i:integer);
  var m:mstr;
  begin
    m:=strr(i);
    getmstr (t,m);
    i:=valu(m)
  end;

  procedure euwanted;
  begin
    writestr ('Wanted status: '^S+yesno(wanted in eurec.config));
    writestr ('New wanted status:');
    if yes
      then eurec.config:=eurec.config+[wanted]
      else eurec.config:=eurec.config-[wanted];
    writelog (18,1,yesno(wanted in eurec.config))
  end;

  procedure eudel;
  var fnt:text; dummystr:mstr;
  begin
    writestr (^R'Delete user '^F+eurec.handle+^R'?  ['^A'N'^R']:');
    if yes then begin
      writestr(^M'Add user to the System Blacklist? *');
      if yes then begin
       if not exist(configset.textfiledi+'Blacklst') then begin
       assign(fnt,configset.textfiledi+'Blacklst');
       rewrite(fnt);
       textclose(fnt);
       end;
       assign(fnt,configset.textfiledi+'Blacklst');
       append(fnt);
       writeln(fnt,eurec.handle);
       textclose(fnt);
       end;
      deleteuser (eunum);
      seek (ufile,eunum);
      read (ufile,eurec);
      writelog (18,9,'')
    end
  end;

  Procedure EuMainConference;
  Var I,J:Integer;
  Begin
    For I:=1 to 5 Do
       If Eurec.Conf[I] then WriteLn('Allowed in Main Conference #',I)
       Else WriteLn('Not allowed in Main Conference #',i);
    WriteStr(^M'Which Conference to Change:');
    If Input='' then Else Begin
    I:=Valu(Input);
    If (I>0) and (I<6) then
      Eurec.Conf[I]:=Not Eurec.Conf[I];
    End;
  End;

  procedure euname;
  var m:mstr;
  begin
    m:=eurec.handle;
    getmstr ('name',m);
    if not match (m,eurec.handle) then
      if lookupuser (m)<>0 then begin
        writestr ('Already exists!  Are you sure? *');
        if not yes then exit
      end;
    eurec.handle:=m;
    writelog (18,6,m)
  end;

  Procedure eurealname;
  var m:mstr;
  begin
    m:=eurec.realname;
    getmstr ('Real Name',m);
      If m>'' then eurec.realname:=m;
  end;

  Procedure euSpecialNote;
  var m:mstr;
  begin
    m:=eurec.SpecialSysopNote;
    getmstr ('Special SysOp Note',m);
      If m>'' then eurec.specialsysopnote:=m;
  End;

  procedure eupassword;
  begin
    if not truesysop
      then truesysops
      else begin
        getsstr ('password',eurec.password);
        writelog (18,8,'')
      end
  end;

  procedure eulevel;
  var n:integer;
  begin
    n:=eurec.level;
    getint ('level',n);
    if (n>=configset.sysopleve) and (not truesysop)
      then truesysops
      else begin
        eurec.level:=n;
        writelog (18,15,strr(n))
      end
  end;

  procedure eutimelimit;
  var n:integer;
  begin
    n:=eurec.timelimits;
    getint('time limit',n);
    eurec.timelimits:=n;
  end;

  procedure eudratio;
  var n:integer;
  begin
    n:=eurec.udratio;
    getint('Upload/Download Ratio',n);
    eurec.udratio:=n;
  end;

  procedure eudkratio;
  var n:integer;
  begin
       n:=eurec.udkratio;
       getint('Upload/Download K Ratio',n);
       eurec.udkratio:=n;
  end;

  procedure epcratio;
  var n:integer;
  begin
       n:=eurec.pcratio;
       getint('Post/Call Ratio',n);
       eurec.pcratio:=n;
  end;

  procedure eglevel;
  var n:integer;
  begin
  n:=eurec.glevel;
  getint('G-File level',n);
  if (n>=configset.sysopleve) and (not truesysop) then truesysops else eurec.glevel:=n;
  end;

  procedure egfpoints;
  var n:integer;
  begin
  n:=eurec.gpoints;
  getint('G-File points',n);
  eurec.gpoints:=n;
  end;

  procedure euconference;
  var k:integer;
  begin
    writehdr('User currently has the following conference flags set');
    for k:=1 to 20 do
        begin
          if (eurec.confset[k]>0) then write(k) else write('0');
          write(',');
        end;
        writeln('');
    for k:=21 to 31 do
      begin
        if (eurec.confset[k]>0) then write(k) else write('0');
        write(',');
        end;
    if (eurec.confset[32]>0) then writeln('32') else writeln('0');
    writestr(^M^P'Change which flag:*');
    if input='' then exit;
    K:=valu(input);
    if k>32 then begin
       writeln(^M'That is NOT a conference!');
       exit;
     end;
    if (eurec.confset[k]=1) then eurec.confset[k]:=0 else eurec.confset[k]:=1;
  end;

  procedure euusernote;
  var m:mstr;
      p:integer;
  begin
    m:=eurec.usernote;
    getmstr('Account note',m);
    eurec.usernote:=m;
  end;

  procedure euphone;
  var m:mstr;
      p:integer;
  begin
    m:=eurec.phonenum;
    buflen:=15;
    getmstr ('phone number',m);
    p:=1;
    while p<=length(m) do
      if (m[p] in ['0'..'9'])
        then p:=p+1
        else delete (m,p,1);
    if length(m)>7 then begin
      eurec.phonenum:=m;
      writelog (18,16,m)
    end
  end;

  procedure boardflags;
  var quit:boolean;

    procedure listflags;
    var bd:boardrec;
        cnt:integer;
    begin
      seek (bdfile,0);
      for cnt:=0 to filesize(bdfile)-1 do begin
        read (bdfile,bd);
        tab (bd.shortname,9);
        tab (bd.boardname,30);
        writeln (accessstr[getuseraccflag (eurec,cnt)]);
        if break then exit
      end
    end;

    procedure changeflag;
    var bn,q:integer;
        bname:mstr;
        ac:accesstype;
    begin
      buflen:=8;
      writestr ('Board to change access:');
      bname:=input;
      bn:=searchboard(input);
      if bn=-1 then begin
        writeln ('Not found!');
        exit
      end;
      writeln (^B^M'Current access: '^S,
               accessstr[getuseraccflag (eurec,bn)]);
      getacflag (ac,input);
      if ac=invalid then exit;
      setuseraccflag (eurec,bn,ac);
      case ac of
        letin:q:=2;
        keepout:q:=3;
        bylevel:q:=4
      end;
      writelog (18,q,bname)
    end;

    procedure allflags;
    var ac:accesstype;
    begin
      writehdr ('Set all board access flags');
      getacflag (ac,input);
      if ac=invalid then exit;
      writestr ('Confirm [Y/N]:');
      if not yes then exit;
      setalluserflags (eurec,ac);
      writelog (18,5,accessstr[ac])
    end;

  begin
    opentempbdfile;
    quit:=false;
    repeat
      repeat
        writestr (^M'L)ist flags, C)hange one flag, A)ll flags, or Q)uit:');
        if hungupon then exit
      until length(input)<>0;
      case upcase(input[1]) of
        'L':listflags;
        'C':changeflag;
        'A':allflags;
        'Q':quit:=true
      end
    until quit;
    closetempbdfile
  end;

  procedure defualt;
  begin
  eurec.level:=configset.defleve;
  eurec.usernote:=configset.defac;
  eurec.udpoints:=configset.deffp;
  eurec.udlevel:=configset.deffil;
  eurec.glevel:=configset.defgfil;
  eurec.gpoints:=configset.defgp;
  end;

  procedure specialsysop;

    procedure getsysop (c:configtype);
    begin
      writeln ('Section ',sectionnames[c],': '^S,
               sysopstr[c in eurec.config]);
      writestr ('Grant sysop access? *');
      if length(input)<>0
        then if yes
          then
            begin
              eurec.config:=eurec.config+[c];
              writelog (18,10,sectionnames[c])
            end
          else
            begin
              eurec.config:=eurec.config-[c];
              writelog (18,11,sectionnames[c])
            end
    end;

  begin
    if not truesysop then begin
      truesysops;
      exit
    end;
    writestr
('Section of M)ain, F)ile, B)ulletin, V)oting, E)mail, D)atabase, P)Doors:');
    if length(input)=0 then exit;
    case upcase(input[1]) of
      'M':getsysop (mainsysop);
      'F':getsysop (udsysop);
      'B':getsysop (bulletinsysop);
      'V':getsysop (votingsysop);
      'E':getsysop (emailsysop);
      'D':getsysop (databasesysop);
      'P':getsysop (doorssysop)
    end
  end;

  procedure getlogint (prompt:mstr; var i:integer; ln:integer);
  begin
    getint (prompt,i);
    writelog (18,ln,strr(i))
  end;

procedure IceCube;
var cpu:integer;
begin
ClearScr;
WriteLn(^R'╒═══════════════════════════════════════════════════════════════════════════╕');
WriteLn(^R'│ '^P'Command '^S':                  '^O'('^U'Q'^O')uit               '^A'ViSiON v0.82 User Editor  '^R'│');
WriteLn(^R'╘═══════════════════════════════════════════════════════════════════════════╛');
Writeln('╒═══════════════════════════════════════════════════════════════════════════╕');
Writeln('│'^P' ('^S'H'^P') User Handle :'^R'                         '^P'                              '^R'  │');
Writeln('├───────────────────────────────────────────────────────────────────────────┤');
Writeln('│'^P' ('^S'L'^P') Main Level   :'^R'                         '^P'('^S'C'^P') Conf 1 Access  :'^R'           │');
Writeln('│'^P' ('^S'F'^P') File Level   :'^R'                         '^P'('^S'C'^P') Conf 2 Access  :'^R'           │');
Writeln('│'^P' ('^S'O'^P') File Points  :'^R'                         '^P'('^S'C'^P') Conf 3 Access  :'^R'           │');
Writeln('│'^P' ('^S'N'^P') Phone Number :'^R'                         '^P'('^S'C'^P') Conf 4 Access  :'^R'           │');
Writeln('│'^P' ('^S'M'^P') Real Name    :'^R'                         '^P'('^S'C'^P') Conf 5 Access  :'^R'           │');
Writeln('│'^P' ('^S'T'^P') Time Left    :'^R'                         '^P'('^S'W'^P') Wanted Status  :'^R'           │');
Writeln('│'^P' ('^S'U'^P') User Note    :'^R'                         '^P'('^S'G'^P') Gfile Level    :'^R'           │');
writeln('│'^P' ('^S'P'^P') Password     :'^R'                         '^P'('^S'+'^P') Grant Def Lvls  '^R'           │');
writeLn('│'^P' ('^S'1'^P') Posted       :'^R'                         '^P'('^S'2'^P') # Of Uploads   :'^R'           │');
WriteLn('│'^P' ('^S'3'^P') Uploaded K   :'^R'                         '^P'('^S'4'^P') # Of Downloads :'^R'           │');
writeln('│'^P' ('^S'Z'^P') Private Note :'^R'                         '^P'('^S'5'^P') Required UDk Ratio:'^R'        │');
WriteLn('│'^P' ('^S'6'^P') Required UD Ratio:'^R'                     '^P'('^S'7'^P') Required PCR:              '^R'│');
Writeln('╘═══════════════════════════════════════════════════════════════════════════╛');
Writeln(^R'╒═══════════════════════════════════════════════════════════════════════════╕');
Writeln(^R'│ '^F'('^A'S'^F')ee User Stats ('^A'I'^F')nfoforms ('^A'B'^F')oard Flags ('^A'Y'^F') SysOp Privilages ('^A'D'^F+
 ')elete  '^R'│');
Writeln(^R'╘═══════════════════════════════════════════════════════════════════════════╛');
printxy(5,21,eurec.handle);
printxy(7,23,strr(eurec.level));
printxy(8,23,strr(eurec.udlevel));
printxy(9,23,strr(eurec.udpoints));
printxy(10,23,eurec.Phonenum);
Printxy(11,23,eurec.realname);
printxy(12,23,strr(eurec.timetoday));
printxy(13,23,eurec.usernote);
if local Then printxy(14,23,eurec.Password) Else Printxy(14,23,'[Classified]');
Printxy(15,23,strr(eurec.nbu));
PrintXy(16,23,strr(eurec.upkay));
PrintXy(17,23,eurec.specialsysopnote);
If eurec.udratio=0 then Printxy(18,26,'N/A') Else Printxy(18,26,strr(eurec.udratio)+'%');
if eurec.conf[1] then
printxy(7,69,'Yes') else
printxy(7,69,'No');
if eurec.conf[2] then
printxy(8,69,'Yes') else
printxy(8,69,'No');
if eurec.conf[3] then
printxy(9,69,'Yes') else
printxy(9,69,'No');
if eurec.conf[4] then
printxy(10,69,'Yes') else
printxy(10,69,'No');
if eurec.conf[5] then
printxy(11,69,'Yes') else
printxy(11,69,'No');
printxy(12,69,yesno(wanted in eurec.config));
Printxy(13,69,strr(Eurec.glevel));
Printxy(15,69,strr(eurec.uploads));
PrintXy(16,69,strr(eurec.downloads));
If eurec.UDKratio=0 then printxy(17,70,'N/A') Else Printxy(17,70,strr(eurec.UDKratio)+'%');
If eurec.pcratio=0 then printxy(18,64,'N/A') Else Printxy(18,64,strr(eurec.Pcratio)+'%');
goxy(2,2);
Write(^P' Command'^S' :');
end;

procedure choose;
var
gg:char;
tmp,cpu:integer;
imdone:boolean;
    procedure gox;
       Begin
       GoXY(1,23);
       End;
      Begin
      Repeat
      icecube;
        GG:=' ';
        Repeat
          Repeat
          If hungupon Then exit;
          Until charready Or hungupon;
          gg:=readchar;If Length(GG)=0 Then GG:=' ';GG:=UpCase(GG);
        Until (Pos(GG,'HDLFONMTUPSBIYCWGZ1234567+Q')>0) or hungupon;
        if gg='H' then begin
        gox;
        euname;
        end;
       if gg='D' then begin
       gox;
       eudel;
       end;
       if gg='L' then  begin
       gox;
       eulevel;
       end;
       if gg='F' then begin
       gox;
       getlogint('u/d level',eurec.udlevel,14);
       end;
       if gg='O' then begin
       gox;
       Getlogint('u/d points',eurec.udpoints,7);
       end;
       if gg='N' then begin
       gox;
       euphone;
       end;
       if gg='M' then begin
       gox;
       eurealname;
       end;
       if gg='T' then begin
       gox;
        getlogint('time for today',eurec.timetoday,12);
        end;
        if gg='U' then  begin
        gox;
        euusernote;
        end;
        if gg='P' then  begin
        gox;
        if local Then eupassword;
        if unum=1 then eupassword;
        end;
        if gg='S' then  begin
        gox;
        ShowUserStats(eurec);
        WriteSTr(^O'Press '^F'['^A'Enter'^F']:*');
        end;
        if gg='B' then  begin
        gox;
       boardflags;
       end;
       if gg='I' then begin
       gox;
       begin
          writestr(^M^P'Which infoform to view [1-5] ['^A'1'^P']:*');
          if input='' then input:='1';
          tmp:=valu(input);
          if (tmp>0) and (tmp<6) then Begin
           showinfoforms(strr(eunum),tmp);
           WriteStr(^O'Press '^F'['^A'Enter'^F']:*');
           End;
          end;
       end;
       if gg='Y' then begin
       gox;
      SpecialSysop;
      end;
      if gg='C' then begin
      gox;
      EuMainConference;
      end;
      if gg='W' then begin
      gox;
      euwanted;
      end;
      if gg='G' then begin
      gox;
      Getlogint('gfile level',eurec.glevel,7);
      getlogint('gfile points',eurec.gpoints,7);
      end;
      if gg='+' then begin
      gox;
      Defualt;
      end;
      If gg='1' then Begin
      gox;
      cpu:=eurec.nbu;
      GetInt('Number Of Posts',cpu);
      eurec.nbu:=cpu;
      End;
      If gg='2' then Begin
      Gox;
      cpu:=eurec.uploads;
      GetInt('Number Of Uploads',cpu);
      eurec.uploads:=cpu;
      End;
      If gg='3' then Begin
      Gox;
      cpu:=eurec.upkay;
      Getint('Uploads K',cpu);
      eurec.upkay:=cpu;
      End;
      If gg='4' then Begin
      Gox;
      cpu:=eurec.downloads;
      GetInt('Number Of Downloads',cpu);
      eurec.downloads:=cpu;
      End;
      If gg='5' then Begin
      Gox;
      cpu:=eurec.udkratio;
      GetInt('New Required U/D ''K'' Ratio to download',cpu);
      eurec.udkratio:=cpu;
      End;
      If gg='6' then Begin
      gox;
      cpu:=eurec.udratio;
      GetInt('New Required U/D Ratio to download',cpu);
      eurec.udratio:=cpu;
      End;
      If gg='7' then Begin
      gox;
      cpu:=eurec.PCRatio;
      GetInt('New (P)ost (C)all (R)atio',cpu);
      eurec.pcratio:=cpu;
      End;
      If gg='Z' then Begin
      Gox;
      EuSpecialNote;
      End;
   if gg='Q' then imdone:=true else imdone:=false;
    gox;
    Until Imdone;
    end;

var q:integer;
   tmp:integer;
begin
  writeurec;
  seek (ufile,eunum);
  read (ufile,eurec);
  writelog (2,3,eurec.handle);
  WriteStr(^F'Use '^A'ViSiON '^F'SysOp Full Screen User Editor? '^P'['^S'Y'^P']:*');
  If input='' then input:='Y';
  If yes then Begin
     choose;
     writeufile (eurec,eunum);
     readurec;
     exit;
  end;
  repeat
   WriteLn(^M^R'['^S+Eurec.Handle+^R']');
    q:=menu('User edit','UEDIT','SDHPLOEWTBQYNIA+CXGF!$^&J');
    case q of
      1:begin
        showuserstats(eurec);
        writelog(18,13,'');
        if (DateStr(Eurec.ExpDate)='0/0/80') or (datestr(eurec.expdate)='0/0/128') then
        writeln(^M'Users account does not expire!') else
        writeln(^M'Account Expires on ',datestr(eurec.expdate));
        end;
      2:eudel;
      3:euname;
      4:eupassword;
      5:eulevel;
      6:getlogint ('u/d points',eurec.udpoints,7);
      7:getlogint ('u/d level',eurec.udlevel,14);
      8:euwanted;
      9:getlogint ('time for today',eurec.timetoday,12);
      10:boardflags;
      12:specialsysop;
      13:euphone;
      14:begin
          writestr(^M^P'Which infoform to view [1-5]: [1]:*');
          if input='' then input:='1';
          tmp:=valu(input);
          if (tmp>0) and (tmp<6) then Begin
           showinfoforms(strr(eunum),tmp);
           WriteStr(^O'Press '^F'['^A'Enter'^F']:*');
          end;
         End;
      15:euusernote;
      16:begin
          writestr ('Set to user defaults:');
            if yes then begin
              eurec.level:=configset.defleve;
              eurec.usernote:=configset.defac;
              eurec.udpoints:=configset.deffp;
              eurec.udlevel:=configset.deffil;
              eurec.glevel:=configset.defgfil;
              eurec.gpoints:=configset.defgp;
            end;
        end;
      17:euconference;
      18:begin
              if (datestr(eurec.expdate)='0/0/128') or (DateStr(Eurec.ExpDate)='0/0/80')
               then writeln(^M^P'users account does not expire!') else
                      writeln(^M^P'Users current Expiration date is '^R,datestr(eurec.expdate));
              writestr(^M'Enter new expiration date, 00/00/80 for no expiration [mm/dd/yy]:');
              eurec.expdate:=dateval(input);
           end;
     19:eglevel;
     20:egfpoints;
     21:eudratio;
     22:eudkratio;
     23:epcratio;
     24:eutimelimit;
     25:EuMainConference;
     end
  until hungupon or (q=11);
  writeufile (eurec,eunum);
  readurec
end;

  Procedure printnews;
    Var nfile:File Of newsrec;
      line:Integer;
      Ntmp:newsrec;cnt:Integer;
    Begin
      Assign(nfile,'News');
      Reset(nfile);
      If IOResult<>0 Then exit;
      If FileSize(nfile)=0 Then Begin
        Close(nfile);
        exit
      End;
      clearscr;
      if ansigraphics in urec.config then begin
        blowup(1,1,27,3);
        write(direct,#27,'[2;3H');
      end;
      writeln(^S'News: [Ctrl-X] to abort'^M^M^M);
      cnt:=0;
      While Not(EoF(nfile) Or break Or hungupon) Do Begin
        Read(nfile,Ntmp);
        If issysop or (ntmp.location>=0) And (ntmp.maxlevel>=urec.level) And (urec.level>=ntmp.level) Then Begin
          inc(cnt);
        WriteLn(^B'News Item #'^S,cnt,^R' - "'^S,ntmp.title,^R'" from '^S,ntmp.from,^R'');
        WriteLn(^B'Date: ['^S,datestr(ntmp.when),^R']    Level ['^S,ntmp.level,' - ',ntmp.maxlevel,^R']');
        WriteLn(^B^P'__________________________________________');
          printtext(Ntmp.location);
          writestr(^P'Press '^S'[Return]'^P' to continue.*')
        End;
      End;
      Close(nfile)
    End;



procedure openusfile;
const newusers:userspecsrec=(name:'New users';Expired:True;minlevel:1;maxlevel:1;
         minlaston:-maxint;maxlaston:maxint;minpcr:-maxint;maxpcr:maxint);
begin
  assign (usfile,'userspec');
  reset (usfile);
  if ioresult<>0 then begin
    rewrite (usfile);
    if configset.level2n<>0 then newusers.maxlevel:=configset.level2n;
    write (usfile,newusers)
  end
end;

procedure editspecs (var us:userspecsrec);

  procedure get (tex:string; var value:integer; min:boolean);
  var vstr:sstr;
  begin
    buflen:=6;
    if abs(value)=maxint then vstr:='None' else vstr:=strr(value);
    writestr (tex+' ['+vstr+']:');
    if input[0]<>#0
      then if upcase(input[1])='N'
        then if min
          then value:=-maxint
          else value:=maxint
        else value:=valu(input)
  end;

  procedure getreal (tex:string; var value:real; min:boolean);
  var vstr:sstr;
      s:integer;
  begin
    buflen:=10;
    if abs(value)=maxint then vstr:='None' else vstr:=streal(value);
    writestr (tex+' ['+vstr+']:');
    if length(input)<>0
      then if upcase(input[1])='N'
        then if min
          then value:=-maxint
          else value:=maxint
        else begin
          val (input,value,s);
          if s<>0 then value:=0
        end
  end;

begin
  writeln (^B^M'Enter specifications; N for none.'^M);
  buflen:=30;
  writestr ('Specification set name ['+us.name+']:');
  if length(input)<>0
    then if match(input,'N')
      then us.name:='Unnamed'
      else us.name:=input;
  get ('Lowest level',us.minlevel,true);
  get ('Highest level',us.maxlevel,true);
  get ('Lowest #days since last call',us.minlaston,true);
  get ('Highest #days since last call',us.maxlaston,true);
  getreal ('Lowest post to call ratio',us.minpcr,true);
  getreal ('Highest post to call ratio',us.maxpcr,true);
  WriteStr('Search for expired accounts? *');
  us.expired:=yes;
end;

function getspecs (var us:userspecsrec):integer; { -1:not saved   >0:in file }
begin
  with us do begin
    name:='Unnamed';                     { Assumes USFILE is open !! }
    minlevel:=-maxint;
    maxlevel:=maxint;
    minlaston:=-maxint;
    maxlaston:=maxint;
    minpcr:=-maxint;
    maxpcr:=maxint;
    expired:=false;
  end;
  editspecs (us);
  writestr (^M'Save these specs to disk? *');
  if yes then begin
    seek (usfile,filesize(usfile));
    write (usfile,us);
    getspecs:=filesize(usfile)
  end else getspecs:=-1
end;

function searchspecs (var us:userspecsrec; name:mstr):integer;
var v,pos:integer;
begin
  v:=valu(name);
  seek (usfile,0);
  pos:=1;
  while not eof(usfile) do begin
    read (usfile,us);
    if match(us.name,name) or (valu(name)=pos) then begin
      searchspecs:=pos;
      exit
    end;
    pos:=pos+1
  end;
  searchspecs:=0;
  writestr (^M'Not found!')
end;

procedure listspecs;
var us:userspecsrec;
    pos:integer;

  procedure writeval (n:integer);
  begin
    if abs(n)=maxint then write ('   None') else write(n:7)
  end;

  procedure writevalreal (n:real);
  begin
    if abs(n)=maxint then write ('   None') else write(n:7:2)
  end;

begin
  writehdr ('User Specification Sets');
  seek (usfile,0);
  pos:=0;
  tab ('',28);
  tab('Expired',7);
  tab ('    Level    ',14);
  tab ('  Last Call  ',14);
  writeln ('  Post/Call Ratio  ');
  while not (break or eof(usfile)) do begin
    pos:=pos+1;
    read (usfile,us);
    write (pos:3,'. ');
    tab (us.name,23);
    if us.expired then tab(' Yes',7) else tab(' No',7);
    writeval (us.minlevel);
    writeval (us.maxlevel);
    writeval (us.minlaston);
    writeval (us.maxlaston);
    writevalreal (us.minpcr);
    writevalreal (us.maxpcr);
    writeln
  end
end;

function selectaspec (var us:userspecsrec):integer; {  0 = none         }
var done:boolean;                                   { -1 = not in file  }
    pos:integer;                                    { -2 = added to end }
begin
  selectaspec:=0;
  openusfile;
  if filesize(usfile)=0
    then selectaspec:=getspecs(us)
    else
      repeat
        if hungupon then exit;
        done:=false;
        writestr (^M'Specification set name (?=list, A=add):');
        if length(input)=0
          then done:=true
          else if match(input,'A')
            then
              begin
                pos:=getspecs(us);
                if pos>0
                  then selectaspec:=-2
                  else selectaspec:=-1;
                done:=true
              end
            else if match(input,'?')
              then listspecs
              else
                begin
                  pos:=searchspecs (us,input);
                  done:=pos<>0;
                  selectaspec:=pos
                end
      until done;
  close (usfile)
end;

function selectspecs (var us:userspecsrec):boolean;
var dummy:integer;
begin
  dummy:=selectaspec (us);
  selectspecs:=dummy=0
end;

procedure deletespecs (pos:integer);
var cnt:integer;
    us:userspecsrec;
begin
  openusfile;
  for cnt:=pos to filesize(usfile)-1 do begin
    seek (usfile,cnt);
    read (usfile,us);
    seek (usfile,cnt-1);
    write (usfile,us)
  end;
  seek (usfile,filesize(usfile)-1);
  truncate (usfile);
  close (usfile)
end;

procedure editoldspecs;
var pos:integer;
    us:userspecsrec;
begin
  repeat
    pos:=selectaspec (us);
    if pos>0 then begin
      buflen:=1;
      writestr (^M'E)dit or D)elete? *');
      if length(input)=1 then case upcase(input[1]) of
        'E':begin
              editspecs (us);
              openusfile;
              seek (usfile,pos-1);
              write (usfile,us);
              close (usfile)
            end;
        'D':deletespecs (pos)
      end
    end
  until (pos=0) or hungupon
end;

procedure editusers;
var eunum:integer;
    matched:boolean;

  procedure elistusers (getspecs:boolean);
  var cnt,f,l:integer;
      u:userrec;
      us:userspecsrec;

    procedure listuser;
    begin
      write (cnt:4,' ');
      tab (u.handle,31);
      write (u.level:6,' ');
      tab (datestr(u.laston),8);
      write (u.nbu:6,u.numon:6,' ');
      if datestr(u.expdate)='0/0/80' then writeln('N/A') else writeln(datestr(u.expdate));
    end;

  begin
    if getspecs
      then if selectspecs(us)
        then exit
        else
          begin
            f:=1;
            l:=numusers
          end
      else parserange (numusers,f,l);
    seek (ufile,f);
    matched:=false;
    writeln (^B^M^M' Num Name                            Level ',
             'Last on  Posts Calls Exp Date');
    for cnt:=f to l do begin
      read (ufile,u);
      if (not getspecs) or fitsspecs(u,us) then begin
        listuser;
        matched:=true
      end;
      if break or xpressed then exit
    end;
    if not matched then
      if getspecs
        then writeln (^B^M'No users match specifications!')
        else writeln (^B^M'No users found in that range!')
  end;

procedure globalnew;
var cnt,f,l:integer;
    U:userrec;
begin
f:=1;
L:=numusers;
seek(ufile,f);
cnt:=0;
for f:=1 to l do begin
  read(ufile,u);
  if (u.level<=configset.level2n) and (u.handle<>'') then begin
   cnt:=cnt+1;
     writestr(^M^P'Edit ['^R+u.handle+^P'] ? *');
     if yes then begin
       edituser(f);
       seek(ufile,f+1);
       writeln(^B^U'Continuing with the scan...');
     end;
     end;
  end;
writeln(^B^R'End of user list! ['^P,cnt,^R'] Match(s) found!');
end;


begin
  repeat
    writestr (^M'User to edit [?,??=list], [N=Global New Users]:');
    if (length(input)=0) or (match(input,'Q')) then exit;
    if match(input,'N') then begin
       globalnew;
       exit;
    end;
    if input[1]='?'
      then elistusers (input='??')
      else begin
        eunum:=lookupuser (input);
        if eunum=0
          then writestr ('User not found!')
          else edituser (eunum)
      end
  until hungupon
end;

procedure zapspecifiedusers;
var us:userspecsrec;
    confirm:boolean;
    u:userrec;
    cnt:integer;
    done:boolean;
begin
  if selectspecs (us) then exit;
  writestr ('Confirm each deletion individually? *');
  if length(input)=0 then exit;
  confirm:=yes;
  if not confirm then begin
    writestr (^M'Are you SURE you want to mass delete without confirmation? *');
    if not yes then exit
  end;
  for cnt:=1 to numusers do begin
    seek (ufile,cnt);
    read (ufile,u);
    if (length(u.handle)>0) and fitsspecs (u,us) then begin
      if confirm
        then
          begin
            done:=false;
            repeat
              writestr ('Delete '+u.handle+' (Y/N/X/E):');
              if length(input)>0 then case upcase(input[1]) of
                'Y':begin
                      done:=true;
                      writeln ('Deleting '+u.handle+'...');
                      deleteuser (cnt)
                    end;
                'N':done:=true;
                'X':exit;
                'E':begin
                      edituser(cnt);
                      writeln;
                      writeln
                    end
              end
            until done
          end
        else
          begin
            writeln ('Deleting '+u.handle+'...');
            if break then begin
              writestr ('Aborted!!');
              exit
            end;
            deleteuser (cnt)
          end
    end
  end
end;

procedure showallsysops;
var n:integer;
    u:userrec;
    q:set of configtype;
    s:configtype;

  procedure showuser;
  const sectionnames:array [udsysop..databasesysop] of string[20]=
         ('File transfer','Bulletin section','Voting booths',
          'E-mail section','Doors','Main menu','Databases');
  var s:configtype;
  begin
    writeln (^B^M'Name:  '^S,u.handle,
               ^M'Level: '^S,u.level,^M);
    for s:=udsysop to databasesysop do
      if s in u.config then
        writeln ('Sysop of the ',sectionnames[s]);
    writestr (^M'Edit user? *');
    if yes then edituser (n)
  end;

begin
  q:=[];
  for s:=udsysop to databasesysop do q:=q+[s];
  for n:=1 to numusers do begin
    seek (ufile,n);
    read (ufile,u);
    if (u.level>=configset.sysopleve) or (q*u.config<>[]) then showuser
  end
end;

procedure readfeedback;
var ffile:file of mailrec;
    m:mailrec;
    me:message;
    cur:integer;

  function nummessages:integer;
  begin
    nummessages:=filesize(ffile)
  end;

  function checkcur:boolean;
  begin
    if length(input)>1 then cur:=valu(copy(input,2,255));
    if (cur<1) or (cur>nummessages) then begin
      writestr (^M'Message out of range!');
      cur:=0;
      checkcur:=true
    end else begin
      checkcur:=false;
      seek (ffile,cur-1);
      read (ffile,m)
    end
  end;

  procedure readnum (n:integer);
  begin
    cur:=n;
    input:='';
    if checkcur then exit;
    writeln (^M^R'Message: '^S,cur,
               ^M^R'Title:   '^S,m.title,
               ^M^R'Sent by: '^S,m.sentby,
               ^M^R'Sent on: '^S,datestr(m.when),' at ',timestr(m.when),^M);
    if break then exit;
    printtext (m.line)
  end;

  procedure writecurmsg;
  begin
    if (cur<1) or (cur>nummessages) then cur:=0;
    write (^B^M'Current msg: '^S);
    if cur=0 then write ('None') else begin
      seek (ffile,cur-1);
      read (ffile,m);
      write (m.title,' by ',m.sentby)
    end
  end;

  procedure delfeedback;
  var cnt:integer;
  begin
    if checkcur then exit;
    deletetext (m.line);
    for cnt:=cur to nummessages-1 do begin
      seek (ffile,cnt);
      read (ffile,m);
      seek (ffile,cnt-1);
      write (ffile,m)
    end;
    seek (ffile,nummessages-1);
    truncate (ffile);
    cur:=cur-1
  end;

  procedure editusr;
  var n:integer;
  begin
    if checkcur then exit;
    n:=lookupuser (m.sentby);
    if n=0
      then writestr ('User disappeared!')
      else edituser (n)
  end;

  procedure infoform;
  var info:integer;
  begin
    if checkcur then exit;
    writestr('What infoform to view [1-5]: [1]:*');
    if input='' then input:='1';
    info:=valu(input);
    if (info>0) and (info<6) then
    showinfoforms (m.sentby,info)
  end;

  procedure nextfeedback;
  begin
    cur:=cur+1;
    if cur>nummessages then begin
      writestr (^M'Sorry, no more feedback!');
      cur:=0;
      exit
    end;
    readnum (cur)
  end;

  procedure readagain;
  begin
    if checkcur then exit;
    readnum (cur)
  end;

  procedure replyfeedback;
  begin
    if checkcur then exit;
    sendmailto (m.sentby,false)
  end;

  procedure listfeedback;
  var cnt:integer;
  begin
    if nummessages=0 then exit;
    thereare (nummessages,'piece of feedback','pieces of feedback');
    if break then exit;
    writeln (^M'Num Title                          Left by'^M);
    seek (ffile,0);
    for cnt:=1 to nummessages do begin
      read (ffile,m);
      tab (strr(cnt),4);
      if break then exit;
      tab (m.title,31);
      writeln (m.sentby);
      if break then exit
    end
  end;

var q:integer;
label exit;
begin
  assign (ffile,configset.forumdi+'Feedback');
  reset (ffile);
  if ioresult<>0 then rewrite (ffile);
  cur:=0;
  repeat
    if nummessages=0 then begin
      writestr ('Sorry, no feedback!');
      goto exit
    end;
    writecurmsg;
    q:=menu ('Feedback','FEED','Q#DEIR_AL');
    if q<0
      then readnum (-q)
      else case q of
        3:delfeedback;
        4:editusr;
        5:infoform;
        6:replyfeedback;
        7:nextfeedback;
        8:readagain;
        9:listfeedback;
      end
  until (q=1) or hungupon;
  exit:
  close (ffile)
end;


Procedure RemoteDosShell;
Begin
    If ConfigSet.GatePass<>'' then
        Begin
            Dots:=True;
            WriteStr(^M^P'Dos Shell Password:');
            Dots:=False;
            If not match(input,configset.gatepass) then
                 Begin
                 WriteLn(^G^S'WRONG!'^M);
                 Exit;
                 End;
            End;
    ClearScr;
    WriteLog(2,13,TimeStr(Now));
    WriteLn(^S'Type "'^A'Exit'^S'" to return to ViSiON!');
    Delay(1000);
        closeport;
    Exec(GetEnv('Comspec'),'/C COMMAND < GATE'+STRR(Configset.UseCo)+' > GATE'+Strr(ConfigSet.UseCo));
    setparam(configset.useco,baudrate,false);
    ChDir(Copy(ConfigSet.ForumDi,1,Length(ConfigSet.ForumDi)-1));
End;

begin
end.